home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
HPAVC
/
HPAVC CD-ROM.iso
/
BOI200P.ZIP
/
HILO.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1992-12-14
|
10KB
|
303 lines
{ $D-}
{$V-}
program HiLo;
{ Copyright (C) 1990 Andrew J. Mead }
{ All Rights Reserved. }
{ Contact POB 1155 Chapel Hill, NC 27514-1155 }
{ Version 0.1 beta dated 12/12/90 using BBS Onliner Interface 1.20 }
{ Version 1.00 12/12/90 BOI 1.20 (about 23 minutes later ) }
{ Vers 2.00 12/12/92 BOI 2.00 }
Uses
dos,
crt,
key,
boidecl,
doorlib,
getcmbbs,
iolib,
support;
Const
bell = #$07;
hilo_ins = 'HILO.INS';
hilo_max = 4096;
Var
hilo_num : word; { computer's number }
guesses : array [1..60] of word;
hilo_won : boolean; { player success indicator }
quit : boolean; { player quit indicator }
hilo_char : char; { standard input variable }
Procedure GETINSTRUCTIONS;
begin {* GetInstructions *}
if Exist(boi_gamedir + hilo_ins) then
DisplayText(boi_gamedir + hilo_ins) { display online instructions }
else NotifySysOp(hilo_ins) { tell player to tell SysOp about missing file }
end; {* GetInstructions *}
Procedure INITIALIZE;
begin {* Initialize *}
hilo_num := Random(hilo_max) + 1; { pick value 1..hilo_max }
quit := false;
playerpoints := 0;
hilo_won := false
end; {* Initialize *}
Procedure PLAYGAME;
var
moved : boolean;
linein : string;
Procedure SHOWGUESS(
guess : byte;
hilit : boolean);
begin {* PlayGame,ShowGuess *}
PortWindow(1,1,80,boi_pagelength);
GotoPortXY(((guess - 1) div 15) * 20 + 1,((guess - 1) mod 15) + 3);
PortColor(cyan,lightgray);
SendString(IntStr(guess,2) + ')',false);
if hilit then PortColor(lightcyan,white);
SendString(IntStr(guesses[guess],5),false);
if guesses[guess] > hilo_num then
begin
if hilit then PortColor(lightgreen,white)
else PortColor(green,white);
SendString(' too high',false)
end
else if guesses[guess] < hilo_num then
begin
if hilit then PortColor(lightred,lightgray)
else PortColor(red,lightgray);
SendString(' too low',false)
end
else
begin
TextPortColor(white);
SendString(' You Got It',false)
end
end; {* PlayGame,ShowGuess *}
Procedure SHOWSCREEN;
var
sloop : byte;
begin {* PlayGame,ShowScreen *}
PortWindow(1,1,80,boi_pagelength);
ClrPortScr;
PortColor(lightcyan,white);
SendString('Hi-Lo Guessing Game',true);
PortColor(cyan,lightgray);
SendString(
' # Guess Result # Guess Result # Guess Result # Guess Result',
false);
if playerpoints > 0 then
begin
for sloop := 1 to playerpoints - 1 do { display each guess }
ShowGuess(sloop,false);
ShowGuess(playerpoints,true) { display and highlight last move }
end;
GotoPortXY(1,18);
PortColor(yellow,white);
SendString('Hi-Lo options: ',false);
LineWrite('[I]nstructions ',brown,lightgray,true);
LineWrite('[T]ime ',brown,lightgray,boi_usetime);
LineWrite('[Q]uit',brown,lightgray,true)
end; {* PlayGame,ShowScreen *}
Procedure WRITELINE;
var
ltime : word;
begin {* PlayGame,WriteLine *}
ClrPortScr;
TextPortColor(lightgray);
if boi_usetime then { if timed game, see if time has expired }
begin
ltime := LeftTime + 1;
if boi_timeover then { player has run out of time }
begin
SendString(
'Your time limit has expired. Game is being exited.',true);
boi_timexp := true;
Exit { no need to continue }
end
else if ltime <= boi_warntime then { player is running out of time }
begin
boi_statmode := sm_time; { force status line to display time }
UpdateStatLine;
if ltime < boi_warntime then { ring bell once per minute }
begin
boi_warntime := ltime;
SendString(#$07,false) { ring bell }
end;
{ tell player how much time they have left }
SendString('You have less than ' +
IntStr(ltime,0) + ' minutes left.',true)
end
end;
{ tell player their current score }
PortColor(yellow,lightgray);
SendString('You have made ',false);
PortColor(cyan,white);
SendString(IntStr(playerpoints,0),false);
PortColor(cyan,lightgray);
SendString(' guesses. ',true);
SendString('Enter your guess: ',false)
end; {* PlayGame,WriteLine *}
Procedure GETINPUT;
const
legalmoves = ['1'..'9','Q','I','T'];
begin {* PlayGame,GetInput *}
TextPortColor(white);
repeat
begin
if (boi_timer - boi_stime >= 182) and (boi_statmode = sm_time) then
UpdateStatLine; { update status line every 10 seconds or so }
hilo_char := ReadPortKey;
if not (UpCase(hilo_char) in legalmoves) then
SendString(bell,false)
end
until UpCase(hilo_char) in legalmoves;
TextPortColor(white);
case UpCase(hilo_char) of
'Q' :
begin
SendString('Quit',true);
SendString('Do you really want to quit? [Y/N] ',false);
repeat hilo_char := UpCase(ReadPortKey)
until hilo_char in ['Y','N'];
if hilo_char = 'Y' then
begin
quit := true;
SendString('Yes',true)
end
else SendString('No',false)
end;
'I' :
begin
GetInstructions;
ShowScreen;
PortWindow(1,20,80,boi_pagelength)
end;
'T' :
begin
PortWindow(1,20,80,boi_pagelength);
ClrPortScr;
GotoPortXY(1,1);
if boi_usetime then SendString('You have less than ' +
IntStr(LeftTime,0) + ' minutes remaining.',false)
else SendString('This function is not operational.',false);
GotoPortXY(1,2);
SendString('Press almost any key to continue. ',false);
ClearBuffers;
hilo_char := ReadPortKey;
ClrPortScr
end;
else
begin
boi_nextchar := hilo_char;
SetPortXY;
if playerpoints > 0 then
ShowGuess(playerpoints,false);
PortWindow(1,20,80,boi_pagelength);
ResetPortXY;
TextPortColor(white);
GetString(linein);
moved := true
end
end
end; {* PlayGame,GetInput *}
Procedure PROCESSGUESS;
var
guessamount : word;
dummy : word;
begin {* PlayGame,ProcessGuess *}
Val(linein,guessamount,dummy);
PortWindow(1,1,80,boi_pagelength);
if (dummy = 0) and (guessamount > 0) and (guessamount < hilo_max) then
begin
Inc(playerpoints);
guesses[playerpoints] := guessamount;
ShowGuess(playerpoints,true);
GotoPortXY(1,19);
ClrPortEOL;
if guessamount = hilo_num then
begin
PortColor(lightred + blink,white + blink);
SendString('Congratulations!!!',false);
PortColor(lightgreen,white);
SendString(' You''ve Done It!!!',false);
hilo_won := true
end
else
begin
TextPortColor(lightgray);
SendString('Your guess was ',false);
if guessamount < hilo_num then
begin
PortColor(lightred,lightgray);
SendString('Too Low',false)
end
else
begin
PortColor(lightgreen,lightgray);
SendString('Too High',false)
end
end
end
else SendString(#7#7#7,false)
end; {* PlayGame,ProcessGuess *}
begin {* PlayGame *}
ShowScreen;
repeat
begin
PortWindow(1,20,80,boi_pagelength);
moved := false;
repeat
begin
WriteLine;
if not boi_timexp then GetInput
end
until moved or quit or boi_timexp;
if not (quit or boi_timexp) then ProcessGuess
end;
until quit or hilo_won or boi_timexp;
PortWindow(1,20,80,boi_pagelength);
ClrPortScr;
TextPortColor(lightgray)
end; {* PlayGame *}
begin {* pHiLo *}
If boi_pagelength < 23 then AbortGame(23); { pagelength must be >= 23 lines }
if boi_allowavt then QueryUser(['1'..'4']) { offer ANSI and AVATAR modes }
else QueryUser(['1','2']); { offer only ANSI modes }
if WriteCopy(true) then GetInstructions;
repeat
begin
Initialize; { initialize game variables }
PlayGame; { play the game }
EndGame('Guessers',hilo_won,bois_points,bois_lowscore) { Hall of Fame }
end
until not boi_replay { player quits, game ends, or no time left }
end. {* pHiLo *}
Copyright (C) 1990,1992 Andrew J. Mead
All Rights Reserved.
For further information, contact:
Andrew J. Mead
POB 1155
Chapel Hill, NC 27514-1155
1:3641/417 FidoNet 75:7919/417 DoorNet
1@9952 WWIVnet 1@9395 VirtualNet